home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 1.iso / HENSA / MATHS / PLPLOT / PLPLOT.ZIP / sys / os2 / stubf / sfstubs.f
Encoding:
Text File  |  1992-05-21  |  9.8 KB  |  365 lines
  1. C***********************************************************************
  2. C
  3. C  sfstubs.f
  4. C
  5. C  This file contains all the fortran stub routines.
  6. C
  7. C***********************************************************************
  8.  
  9.     subroutine plsfnam(fnam)
  10.  
  11.     character*(*) fnam
  12.  
  13.     parameter (maxlen = 300)
  14.     character*1 string1(maxlen), string2(maxlen), string3(maxlen)
  15.     character*1 string4(maxlen), string5(maxlen), string6(maxlen)
  16.     integer s1(75), s2(75), s3(75), s4(75), s5(75), s6(75)
  17.     equivalence ( s1, string1 ), ( s2, string2 )
  18.     equivalence ( s3, string3 ), ( s4, string4 )
  19.     equivalence ( s5, string5 ), ( s6, string6 )
  20.     common /string/ string1, string2, string3, string4, string5, string6
  21.  
  22.     limit = min(len_trim(fnam),maxlen-1)
  23.         do i = 1,limit
  24.        string1(i) = fnam(i:i) 
  25.     enddo
  26.     string1(i) = 0
  27.     
  28.     call plsfnam_(s1)
  29.  
  30.     end
  31.  
  32. C***********************************************************************
  33.  
  34.     subroutine plgfnam(fnam)
  35.  
  36.     character*(*) fnam
  37.  
  38.     parameter (maxlen = 300)
  39.     character*1 string1(maxlen), string2(maxlen), string3(maxlen)
  40.     character*1 string4(maxlen), string5(maxlen), string6(maxlen)
  41.     character*300 stringbuf
  42.     integer s1(75), s2(75), s3(75), s4(75), s5(75), s6(75)
  43.     equivalence ( s1, string1 ), ( s2, string2 )
  44.     equivalence ( s3, string3 ), ( s4, string4 )
  45.     equivalence ( s5, string5 ), ( s6, string6 )
  46.     common /string/ string1, string2, string3, string4, string5, string6
  47.  
  48.     call plgfnam_(s1)
  49.     limit = 1
  50. 10    if (ichar(string1(limit)) .eq. 0) goto 20
  51.     stringbuf(limit:limit) = string1(limit)
  52.     limit = limit + 1
  53.     goto 10
  54.     
  55. 20    fnam = stringbuf(1:limit-1)
  56.  
  57.     end
  58.  
  59. C***********************************************************************
  60.  
  61.     subroutine plaxes(x0,y0,xopt,xtick,nxsub,yopt,ytick,nysub)
  62.  
  63.     real    x0, y0, xtick, ytick
  64.     integer nxsub, nysub
  65.     character*(*) xopt,yopt
  66.  
  67.     parameter (maxlen = 300)
  68.     character*1 string1(maxlen), string2(maxlen), string3(maxlen)
  69.     character*1 string4(maxlen), string5(maxlen), string6(maxlen)
  70.     integer s1(75), s2(75), s3(75), s4(75), s5(75), s6(75)
  71.     equivalence ( s1, string1 ), ( s2, string2 )
  72.     equivalence ( s3, string3 ), ( s4, string4 )
  73.     equivalence ( s5, string5 ), ( s6, string6 )
  74.     common /string/ string1, string2, string3, string4, string5, string6
  75.  
  76.     limit = min(len_trim(xopt),maxlen-1)
  77.         do i = 1,limit
  78.        string1(i) = xopt(i:i) 
  79.         enddo
  80.         string1(i) = 0
  81.  
  82.     limit = min(len_trim(yopt),maxlen-1)
  83.         do i = 1,limit
  84.        string2(i) = yopt(i:i) 
  85.         enddo
  86.     string2(i) = 0
  87.  
  88.     call plaxes_(x0,y0,s1,xtick,nxsub,s2,ytick,nysub)
  89.  
  90.     end
  91.  
  92. C***********************************************************************
  93.  
  94.     subroutine plbox(xopt,xtick,nxsub,yopt,ytick,nysub)
  95.  
  96.     real    xtick, ytick
  97.     integer nxsub, nysub
  98.     character*(*) xopt,yopt
  99.  
  100.     parameter (maxlen = 300)
  101.     character*1 string1(maxlen), string2(maxlen), string3(maxlen)
  102.     character*1 string4(maxlen), string5(maxlen), string6(maxlen)
  103.     integer s1(75), s2(75), s3(75), s4(75), s5(75), s6(75)
  104.     equivalence ( s1, string1 ), ( s2, string2 )
  105.     equivalence ( s3, string3 ), ( s4, string4 )
  106.     equivalence ( s5, string5 ), ( s6, string6 )
  107.     common /string/ string1, string2, string3, string4, string5, string6
  108.  
  109.     limit = min(len_trim(xopt),maxlen-1)
  110.         do i = 1,limit
  111.        string1(i) = xopt(i:i) 
  112.         enddo
  113.         string1(i) = 0
  114.  
  115.     limit = min(len_trim(yopt),maxlen-1)
  116.         do i = 1,limit
  117.        string2(i) = yopt(i:i) 
  118.     enddo
  119.         string2(i) = 0
  120.  
  121.     call plbox_(s1,xtick,nxsub,s2,ytick,nysub)
  122.  
  123.     end
  124.  
  125. C***********************************************************************
  126.  
  127.     subroutine plbox3(xopt,xlabel,xtick,nxsub,yopt,ylabel,ytick,nysub,
  128.      *            zopt,zlabel,ztick,nzsub)
  129.  
  130.     real    xtick, ytick, ztick
  131.     character*(*) xopt,xlabel,yopt,ylabel,zopt,zlabel
  132.     integer nxsub, nysub, nzsub
  133.  
  134.     parameter (maxlen = 300)
  135.     character*1 string1(maxlen), string2(maxlen), string3(maxlen)
  136.     character*1 string4(maxlen), string5(maxlen), string6(maxlen)
  137.     integer s1(75), s2(75), s3(75), s4(75), s5(75), s6(75)
  138.     equivalence ( s1, string1 ), ( s2, string2 )
  139.     equivalence ( s3, string3 ), ( s4, string4 )
  140.     equivalence ( s5, string5 ), ( s6, string6 )
  141.     common /string/ string1, string2, string3, string4, string5, string6
  142.     
  143. c       Convert all those Fortran strings to their C equivalents
  144.  
  145.     limit = min(len_trim(xopt),maxlen-1)
  146.     do i = 1,limit
  147.        string1(i) = xopt(i:i)
  148.         enddo
  149.         string1(i) = 0
  150.  
  151.     limit = min(len_trim(xlabel),maxlen-1)
  152.         do i = 1,limit
  153.        string2(i) = xlabel(i:i)
  154.     enddo
  155.         string2(i) = 0
  156.  
  157.     limit = min(len_trim(yopt),maxlen-1)
  158.         do i = 1,limit
  159.        string3(i) = yopt(i:i)
  160.         enddo
  161.         string3(i) = 0
  162.  
  163.     limit = min(len_trim(ylabel),maxlen-1)
  164.         do i = 1,limit
  165.        string4(i) = ylabel(i:i)
  166.     enddo
  167.         string4(i) = 0
  168.  
  169.     limit = min(len_trim(zopt),maxlen-1)
  170.         do i = 1,limit
  171.        string5(i) = zopt(i:i)
  172.         enddo
  173.         string5(i) = 0
  174.  
  175.     limit = min(len_trim(zlabel),maxlen-1)
  176.         do i = 1,limit
  177.        string6(i) = zlabel(i:i)
  178.     enddo
  179.         string6(i) = 0
  180.  
  181.     call plbox3_( s1, s2, xtick, nxsub, s3, s4, ytick, nysub,
  182.      *          s5, s6, ztick, nzsub )
  183.  
  184.     end
  185.  
  186. C***********************************************************************
  187.  
  188.     subroutine plcon0(z,nx,ny,kx,lx,ky,ly,clevel,nlevel)
  189.     call plcon0_(z,nx,ny,kx,lx,ky,ly,clevel,nlevel)
  190.     end
  191.  
  192. C***********************************************************************
  193.  
  194.     subroutine plcon1(z,nx,ny,kx,lx,ky,ly,clevel,nlevel,xg,yg)
  195.     call plcon1_(z,nx,ny,kx,lx,ky,ly,clevel,nlevel,xg,yg)
  196.     end
  197.  
  198. C***********************************************************************
  199.  
  200.     subroutine plcon2(z,nx,ny,kx,lx,ky,ly,clevel,nlevel,xg,yg)
  201.     call plcon2_(z,nx,ny,kx,lx,ky,ly,clevel,nlevel,xg,yg)
  202.     end
  203.  
  204. C***********************************************************************
  205.  
  206.     subroutine plcont(z,nx,ny,kx,lx,ky,ly,clevel,nlevel)
  207.  
  208.     real    z, clevel
  209.     integer nx, ny, kx, lx, ky, ly, nlevel
  210.     real tr
  211.     common /plplot/ tr(6)
  212.  
  213.     call plcont_(z,nx,ny,kx,lx,ky,ly,clevel,nlevel,tr)
  214.  
  215.     end
  216.  
  217. C***********************************************************************
  218.  
  219.     subroutine pllab(xlab,ylab,title)
  220.  
  221.     character*(*) xlab,ylab,title
  222.  
  223.     parameter (maxlen = 300)
  224.     character*1 string1(maxlen), string2(maxlen), string3(maxlen)
  225.     character*1 string4(maxlen), string5(maxlen), string6(maxlen)
  226.     integer s1(75), s2(75), s3(75), s4(75), s5(75), s6(75)
  227.     equivalence ( s1, string1 ), ( s2, string2 )
  228.     equivalence ( s3, string3 ), ( s4, string4 )
  229.     equivalence ( s5, string5 ), ( s6, string6 )
  230.     common /string/ string1, string2, string3, string4, string5, string6
  231.  
  232.     limit = min(len_trim(xlab),maxlen-1)
  233.         do i = 1,limit
  234.        string1(i) = xlab(i:i) 
  235.         enddo
  236.         string1(i) = 0
  237.  
  238.     limit = min(len_trim(ylab),maxlen-1)
  239.         do i = 1,limit
  240.        string2(i) = ylab(i:i) 
  241.     enddo
  242.         string2(i) = 0
  243.  
  244.     limit = min(len_trim(title),maxlen-1)
  245.         do i = 1,limit
  246.        string3(i) = title(i:i) 
  247.     enddo
  248.         string3(i) = 0
  249.     
  250.     call pllab_(s1,s2,s3)
  251.  
  252.     end
  253.  
  254. C***********************************************************************
  255.  
  256.     subroutine plancol(icolor, name)
  257.  
  258.     integer icolor
  259.     character*(*) name
  260.  
  261.     parameter (maxlen = 300)
  262.     character*1 string1(maxlen), string2(maxlen), string3(maxlen)
  263.     character*1 string4(maxlen), string5(maxlen), string6(maxlen)
  264.     integer s1(75), s2(75), s3(75), s4(75), s5(75), s6(75)
  265.     equivalence ( s1, string1 ), ( s2, string2 )
  266.     equivalence ( s3, string3 ), ( s4, string4 )
  267.     equivalence ( s5, string5 ), ( s6, string6 )
  268.     common /string/ string1, string2, string3, string4, string5, string6
  269.  
  270.     limit = min(len_trim(name),maxlen-1)
  271.         do i = 1,limit
  272.        string1(i) = name(i:i) 
  273.         enddo
  274.         string1(i) = 0
  275.  
  276.     call plancol_(icolor, s1)
  277.  
  278.     end
  279.  
  280. C***********************************************************************
  281.  
  282.     subroutine plmtex(side,disp,pos,xjust,text)
  283.  
  284.     real    disp, pos, xjust
  285.     character*(*) side, text
  286.  
  287.     parameter (maxlen = 300)
  288.     character*1 string1(maxlen), string2(maxlen), string3(maxlen)
  289.     character*1 string4(maxlen), string5(maxlen), string6(maxlen)
  290.     integer s1(75), s2(75), s3(75), s4(75), s5(75), s6(75)
  291.     equivalence ( s1, string1 ), ( s2, string2 )
  292.     equivalence ( s3, string3 ), ( s4, string4 )
  293.     equivalence ( s5, string5 ), ( s6, string6 )
  294.     common /string/ string1, string2, string3, string4, string5, string6
  295.  
  296.     limit = min(len_trim(side),maxlen-1)
  297.         do i = 1,limit
  298.        string1(i) = side(i:i)
  299.         enddo
  300.         string1(i) = 0
  301.  
  302.     limit = min(len_trim(text),maxlen-1)
  303.         do i = 1,limit
  304.        string2(i) = text(i:i)
  305.     enddo
  306.         string2(i) = 0
  307.  
  308.     call plmtex_(s1,disp,pos,xjust,s2)
  309.  
  310.     end
  311.  
  312. C***********************************************************************
  313.  
  314.     subroutine plptex(x,y,dx,dy,xjust,text)
  315.  
  316.     real    x, y, dx, dy, xjust
  317.     character*(*) text
  318.  
  319.     parameter (maxlen = 300)
  320.     character*1 string1(maxlen), string2(maxlen), string3(maxlen)
  321.     character*1 string4(maxlen), string5(maxlen), string6(maxlen)
  322.     integer s1(75), s2(75), s3(75), s4(75), s5(75), s6(75)
  323.     equivalence ( s1, string1 ), ( s2, string2 )
  324.     equivalence ( s3, string3 ), ( s4, string4 )
  325.     equivalence ( s5, string5 ), ( s6, string6 )
  326.     common /string/ string1, string2, string3, string4, string5, string6
  327.  
  328.     limit = min(len_trim(text),maxlen-1)
  329.         do i = 1,limit
  330.        string1(i) = text(i:i)
  331.         enddo
  332.         string1(i) = 0
  333.  
  334.     call plptex_(x,y,dx,dy,xjust,s1)
  335.  
  336.     end
  337.  
  338. C***********************************************************************
  339.  
  340.     subroutine plstart(devname, nx, ny)
  341.  
  342.     character*(*) devname
  343.     integer nx, ny
  344.  
  345.     parameter (maxlen = 300)
  346.     character*1 string1(maxlen), string2(maxlen), string3(maxlen)
  347.     character*1 string4(maxlen), string5(maxlen), string6(maxlen)
  348.     integer s1(75), s2(75), s3(75), s4(75), s5(75), s6(75)
  349.     equivalence ( s1, string1 ), ( s2, string2 )
  350.     equivalence ( s3, string3 ), ( s4, string4 )
  351.     equivalence ( s5, string5 ), ( s6, string6 )
  352.     common /string/ string1, string2, string3, string4, string5, string6
  353.  
  354.     limit = min(len_trim(devname),maxlen-1)
  355.         do i = 1,limit
  356.        string1(i) = devname(i:i)
  357.         enddo
  358.         string1(i) = 0
  359.  
  360.     call plstart_(s1, nx, ny)
  361.  
  362.     end
  363.  
  364. C***********************************************************************
  365.